www.gusucode.com > 6KBBS ASP版 V7.1 > 6KBBS ASP版 V7.1\code\bbs\inc\fun.asp

    <%
function replacecolor(title)
	dim startc,endc,lenc,tmp,titlecolor
	startc=instr(title,"[")
	endc=instr(title,"]")
	lenc=endc-startc
	if lenc=3 and startc>0 then
		tmp=mid(title,startc,lenc+1)
		select case tmp
			case"[原创]"
				titlecolor="blue"
			case"[公告]"
				titlecolor="red"
			case"[贴图]"
				titlecolor="#2f4f4f"
			case"[注意]"
				titlecolor="#cc00cc"
			case"[求助]"
				titlecolor="#ff6600"
			case"[推荐]"
				titlecolor="green"
			case"[转帖]"
				titlecolor="#666633"
			case"[建议]"
				titlecolor="#990000"
			case"[下载]"
				titlecolor="black"
			case"[讨论]"
				titlecolor="red"
			case else
				titlecolor="#3399ff" 
		end select
	end if
	replacecolor=titlecolor
end function

function checkform(str)
if not isnull(str) and str<>"" then
	str	= Replace(str,"&","&amp;")	
	str = replace(str, ">", "&gt;")
	str = replace(str, "<", "&lt;")
checkform=str
end if
end function

function checktitle(str)
if not isnull(str) and str<>"" then
	str	= Replace(str,"&","&amp;")	
	str = replace(str, ">", "&gt;")
	str = replace(str, "<", "&lt;")
	str = Replace(str, CHR(32), " ")
	str = Replace(str, CHR(9), "&nbsp;")
	str = Replace(str, CHR(34), "&quot;")
	str = Replace(str, CHR(39), "&#39;")
	str = Replace(str, CHR(13), "")
	str = Replace(str, "script", "&#115;cript")
	str = Replace(str, "＆#115;", "&#115;")
checktitle = str
end if
end function

function checknum(str)
if isnull(str) or str=""  then
exit function
else
if not isnumeric(str) then
response.write"<center>非法操作导致程序中止!</center>"
response.end
else
checknum=int(str)
end if
end if
end function

Function LeftTrue(str,n)
	If len(str)<=n/2 Then
		LeftTrue=str
	Else
		Dim TStr
		Dim l,t,c
		Dim i
		l=len(str)
		t=l
		TStr=""
		t=0
		for i=1 to l
			c=asc(mid(str,i,1))
			If c<0 then c=c+65536
			If c>255 then
				t=t+2
			Else
				t=t+1
			End If
			If t>n Then exit for
			TStr=TStr&(mid(str,i,1))
		next
		LeftTrue = TStr+"..."
	End If
End Function

Function lockedIpCheck()
	dim num_ip,sql2
 	num_ip=IpEncode(ip)
    set rs=server.createobject("adodb.recordset")
	sql2="select id from lockip where int(startip)<="&num_ip&" and int(endip)>=" & num_ip
    rs.open sql2,conn
		if not rs.eof or not rs.bof then
			rs.close
			set rs=nothing
			closedb
			response.write"你所在网段已被封锁。可能该网段有人捣乱，请联系管理员！"
			response.end
		end if
	rs.close
	set rs=nothing
end function

function IpDecode(byval uip)
	if trim(uip)="" or not isnumeric(uip) then
		IpDecode=0
	else
		uip=Cdbl(uip)
		dim ary_ip(3)
        ary_ip(0)=fix(uip/16777216)
        ary_ip(1)=fix((uip-ary_ip(0)*16777216)/65536)
        ary_ip(2)=fix((uip-fix(uip/65536)*65536)/256)
        uip=uip-fix(uip/65536)*65536
        ary_ip(3)=fix(uip-fix(uip/256)*256)
        IpDecode=join(ary_ip,".")
	end if
end function

function IpEncode(byval uip)
	if isnull(uip) or uip="" then
		IpEncode=0
	else
		dim ary_ip,n
		ary_ip=split(trim(uip),".")
		n=ubound(ary_ip)
		if n=3 then
			IpEncode=ary_ip(0)*256*256*256+ary_ip(1)*65536+ary_ip(2)*256+ary_ip(3)
		else
			IpEncode=0
		end if
	end if
end function

Function RemoveHTML(strHTML)
	Dim objRegExp, Match, Matches
	Set objRegExp = New Regexp
		objRegExp.IgnoreCase = True
		objRegExp.Global = True '取闭合的<> 
		objRegExp.Pattern = "<.+?>" '进行匹配
		Set Matches = objRegExp.Execute(strHTML)
		For Each Match in Matches 
			strHtml=Replace(strHTML,Match.Value,"") 
		Next 
		RemoveHTML=strHTML 
	Set objRegExp = Nothing 
End Function
%>